home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / s_to_z / subdatab / d2unit1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  5.8 KB  |  239 lines
  1. unit D2unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Subdatab,
  8.  
  9.   DemoStat;
  10.  
  11. type
  12.   TForm1 = class(TForm)
  13.     Panel4: TPanel;
  14.     BitBtnClose: TBitBtn;
  15.     Button7: TButton;
  16.     ButtonStatus: TButton;
  17.     ButtonReorg: TButton;
  18.     SUBDataBase1: TSUBDataBase;
  19.     Panel1: TPanel;
  20.     Buttondelete: TButton;
  21.     ListBox1: TListBox;
  22.     Button1: TButton;
  23.     procedure ButtonaddClick(Sender: TObject);
  24.     procedure FormCreate(Sender: TObject);
  25.     procedure FormDestroy(Sender: TObject);
  26.     procedure BitBtnCloseClick(Sender: TObject);
  27.     procedure ButtonStatusClick(Sender: TObject);
  28.     procedure ButtondeleteClick(Sender: TObject);
  29.     procedure SUBDataBase1Create(Sender: TObject);
  30.     procedure ButtonReorgClick(Sender: TObject);
  31.     procedure SUBDataBase1Reorg(Sender: TObject; ReorgAct: Longint);
  32.     procedure ButtonshowClick(Sender: TObject);
  33.   private
  34.     { Private-Deklarationen }
  35.     added : longint;
  36.     showfirst : Boolean;
  37.     procedure Showreccount;
  38.   public
  39.     { Public-Deklarationen }
  40.   end;
  41.  
  42. var
  43.   Form1: TForm1;
  44.  
  45. implementation
  46.  
  47. {$R *.DFM}
  48.  
  49.  
  50. Type TTestDataRecord = record
  51.        Name      : String[10];
  52.        Firstname : String[15];
  53.        anid      : longint;
  54.        useit     : string[30];
  55.      end;
  56.  
  57.  
  58.  
  59. Const   Index_Demo2  = 'DEMO2';
  60.  
  61.  
  62.  
  63. {----------------------------------------------------------------}
  64. procedure TForm1.FormCreate(Sender: TObject);
  65. begin
  66.   SUBDataBase1.open;
  67.   added := 0;
  68.   showfirst := true;
  69.   randomize;
  70.  
  71.   showreccount;
  72.  
  73. end;
  74. {----------------------------------------------------------------}
  75. procedure TForm1.FormDestroy(Sender: TObject);
  76. begin
  77.   SUBDataBase1.Close;
  78. end;
  79. {----------------------------------------------------------------}
  80. procedure TForm1.BitBtnCloseClick(Sender: TObject);
  81. begin
  82.   close;
  83. end;
  84. {----------------------------------------------------------------}
  85. procedure TForm1.ButtonaddClick(Sender: TObject);
  86.  
  87.   var    FTestData     : TTestDatarecord;
  88.  
  89.  
  90.   procedure fillname;
  91.     var j : integer;
  92.   begin
  93.     FTestData.Name[0] := #10;
  94.     for j := 1 to 10 do begin
  95.       FTestData.Name[j] :=  chr(random(26)+ 65) ; {A..Z}
  96.     end;
  97.  
  98.   end;
  99.  
  100.  
  101.   var  i : longint;
  102.  
  103. begin
  104.  
  105.  
  106.    for i := added +1 to added + 200 do begin
  107.      fillchar(FTestData,sizeof(FTestdata),#0);
  108.      fillname;
  109.      FTestData.anid := added + i;
  110.      panel1.caption := 'adding record: '+inttostr(i);
  111.      panel1.repaint;
  112.  
  113.      Try
  114.        SUBDataBase1.addData_Indexe ([Index_Demo2],
  115.                                     [FTestData.Name],
  116.                                     Sizeof(FTestData),
  117.                                     FTestData);
  118.      except
  119.        {duplicate index are allowed!}
  120.      end;
  121.  
  122.       if (i mod 25) = 0 then
  123.         Application.processmessages;
  124.  
  125.    end;
  126.  
  127.    inc(added,200);
  128.  
  129.    showreccount;
  130.  
  131.    showfirst := true;
  132. end;
  133. {----------------------------------------------------------------}
  134. procedure TForm1.showreccount;
  135. begin
  136.   panel1.caption := 'database has '+inttostr(SUBDataBase1.CountKeys(Index_Demo2 ))+' records';
  137. end;
  138. {----------------------------------------------------------------}
  139. procedure TForm1.ButtonStatusClick(Sender: TObject);
  140.   Var SL : Tstringlist;
  141.       F  : TStatusDialog;
  142. begin
  143.   SL := Tstringlist.create;
  144.   SUBDataBase1.GetStatistik (SL);
  145.   F  := TStatusDialog.create(NIL);
  146.   Try
  147.     f.memo1.lines := SL;
  148.     f.showmodal;
  149.   finally
  150.  
  151.     f.free;
  152.     SL.free;
  153.   end;
  154.  
  155. end;
  156. {----------------------------------------------------------------}
  157. procedure TForm1.ButtondeleteClick(Sender: TObject);
  158.  
  159.   var    FTestData     : TTestDatarecord;
  160.          i : longint;
  161. begin
  162. {-}
  163.   for i := 1 to 100 do begin
  164.     SUBDataBase1.FirstIndex (Index_Demo2 );
  165.     if SUBDataBase1.Datenid = -1 then break;
  166.     {no datas found}
  167.  
  168.     SUBDataBase1.ReadActData (  sizeof(FTestData),FTestData);
  169.  
  170.     SUBDataBase1.DeleteData_Indexe ([Index_Demo2],
  171.                                     [FTestData.name],
  172.                                     SUBDataBase1.Datenid);
  173.  
  174.     panel1.caption := 'deleting record: '+inttostr(i);
  175.     panel1.repaint;
  176.  
  177.     if (i mod 25) = 0 then
  178.       Application.processmessages;
  179.  
  180.   end;
  181.  
  182.   showreccount;
  183.  
  184.   showfirst := true;
  185. end;
  186. {----------------------------------------------------------------}
  187. procedure TForm1.SUBDataBase1Create(Sender: TObject);
  188. begin
  189.  
  190.  
  191.   SUBDataBase1.createIndex (Index_Demo2 , 11, true);
  192.                                              {indexlength, duplicate}
  193.  
  194. end;
  195. {----------------------------------------------------------------}
  196.  
  197. procedure TForm1.ButtonReorgClick(Sender: TObject);
  198. begin
  199.   Subdatabase1.Reorganisation;
  200.   showreccount;
  201. end;
  202. {----------------------------------------------------------------}
  203. procedure TForm1.SUBDataBase1Reorg(Sender: TObject; ReorgAct: Longint);
  204. begin
  205.  
  206.   panel1.caption := 'reorg: '+inttostr(ReorgAct)+' until: '+
  207.     inttostr(SUBDataBase1.Reorgmax);
  208.  
  209.   Application.processmessages;
  210.  
  211.  
  212. end;
  213. {----------------------------------------------------------------}
  214. procedure TForm1.ButtonshowClick(Sender: TObject);
  215.   var    FTestData     : TTestDatarecord;
  216.          i : integer;
  217. begin
  218.   if  showfirst then begin
  219.     SUBDataBase1.FirstIndex (Index_Demo2 );
  220.     showfirst := False;
  221.   end;
  222.  
  223.   ListBox1.items.clear;
  224.  
  225.   i := 1;
  226.   repeat
  227.     SUBDataBase1.ReadActData (  sizeof(FTestData),FTestData);
  228.     ListBox1.items.add(FTestData.name+'('+inttostr(FTestData.anid) +')');
  229.     inc(i);
  230.     SUBDataBase1.NextIndex (Index_Demo2, FTestData.name  );
  231.   until (SUBDataBase1.DatenID = -1 )
  232.         or (i >100);
  233.  
  234.   if SUBDataBase1.DatenID = -1 then showfirst := true;
  235.  
  236. end;
  237. {----------------------------------------------------------------}
  238. end.
  239.